Sub AddTableToNewDB()
Dim cat1 As ADOX.Catalog
Dim str1 As String
Dim tbl1 As ADOX.Table
Dim cnxn As ADODB.Connection

'Specify the database that tables will be added to, and the
'columns that the table will contain
str1 = "C:\LunarSociety\NewDB.mdb"
Set cnxn = New ADODB.Connection
cnxn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
     & "Data Source=" & str1
Set cat1 = New ADOX.Catalog
Set cat1.ActiveConnection = cnxn

'Create and name the table
Set tbl1 = New ADOX.Table
With tbl1
     .Name = "Donors"
     Set .ParentCatalog = cat1
     With .Columns
          .Append "DonorID", adInteger
          .Item("DonorID").Properties("AutoIncrement") = True
          .Append "FirstName", adVarWChar, 20
          .Append "LastName", adVarWChar, 25
          .Append "FirstDonationDate", adDate
      End With
End With

'Append new table to Tables collection of NewDB
cat1.Tables.Append tbl1

'Clean up before exiting
Set tbl1 = Nothing
Set cat1 = Nothing
cnxn.Close
Set cnxn = Nothing

End Sub
